{
  Copyright 2012 Sergey Ostanin

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
}

unit MiscUtils;

interface

uses
  FileUtil, SysUtils, Windows, Classes, Math, StrUtils, fgl;

type
  TIntegerArray = array of Integer;

  TRandomIntegerGenerator = function(Range: Integer): Integer;

  TKind = type Int64;

  TUnicodeStringList = TFPGList<UnicodeString>;

  TBigInteger = class
  private
    FNegative: Boolean;
    FModulus: String; { empty string if zero }
    function GetValue: String;
    function GetIsZero: Boolean;
  public
    function IsEqual(Other: TBigInteger): Boolean;
    function IsNearby(Other, Delta: TBigInteger): Boolean;
    function Add(Other: TBigInteger): TBigInteger;
    function Subtract(Other: TBigInteger): TBigInteger;
    function InvertSign: TBigInteger;

    property IsZero: Boolean read GetIsZero;
    property Value: String read GetValue;
  end;

  TFixedPointDecimal = class
  private
    FNegative: Boolean;
    FWholePart: String; { without leading zeros }
    FFractionPart: String; { without trailing zeros }
    function GetValue: String;
    function GetIsZero: Boolean;
  public
    class function Parse(const s: String): TFixedPointDecimal;
    class function MustParse(const s: String): TFixedPointDecimal;
    class function Normalize(const s: String): String;
    class function IsValidNonNegative(const s: String): Boolean;
    function IsEqual(Other: TFixedPointDecimal): Boolean;
    function IsNearby(Other, Delta: TFixedPointDecimal): Boolean;
    function ToBigInteger(Scale: Integer): TBigInteger;

    property FractionPart: String read FFractionPart;
    property IsZero: Boolean read GetIsZero;
    property Negative: Boolean read FNegative;
    property Value: String read GetValue;
    property WholePart: String read FWholePart;
  end;

  TUnicodeFileStream = class(THandleStream)
  public
    constructor CreateNew(const FileName: String; SharedForReading: Boolean = FALSE);
    constructor OpenForRead(const FileName: String);
    destructor Destroy; override;
  end;

  TOutputFile = class
  private
    FStream: TStream;
    FFileName: String;
    FTempFileName: String;
    FCommitted: Boolean;
  public
    constructor Create(const FileName: String);
    destructor Destroy; override;
    procedure Commit;

    property Stream: TStream read FStream;
  end;

  TGenericList<T> = class(TFPGList<T>)
  private type
    TComparator = function(const Left, Right: T): Integer of object;
  private
    FComparator: TComparator;
    function PointerComparator(Left, Right: Pointer): Integer;
  public
    procedure SortEx(Comparator: TComparator);
  end;

  TIntegerList = TGenericList<Integer>;

  TGenericObjectList<T> = class(TFPGObjectList<T>)
  public
    function AddSafely(Item: T): T;
    procedure InsertSafely(Index: Integer; Item: T);
  end;

procedure SplitUnicodeString(const s: UnicodeString; Delimiter: UnicodeChar; Parts: TUnicodeStringList);
function ContainsSpecialCharacter(const s: String): Boolean;
function ContainsUnicodeZeroCharacter(const s: UnicodeString): Boolean;
function CutUnicodeCharacters(const s: UnicodeString; c: UnicodeChar): UnicodeString;
function GetStringTailAfterLastDelimiter(const s: String; Delimiter: Char): String;
function ConvertFloatToString(const Value: Extended; DigitsAfterDecimalPoint: Integer;
  DecimalSeparator: Char; OutputTrailingZeros: Boolean = FALSE): String;
function CommaToDot(const s: String): String;
function DotToUiDecimalSeparator(const s: String): String;
function CollapseSpaces(const s: String): String;
function CollapseUnicodeSpaces(const s: UnicodeString): UnicodeString;
function ExcludeLeadingDot(const s: String): String;
function ReplacePattern(const s, OldPattern, NewPattern: String; out ReplaceCount: Integer): String;
function UnicodeStringConsistsOf(const s: UnicodeString; c: UnicodeChar): Boolean;
function ShiftRegexpBackReferences(const s: UnicodeString): UnicodeString;
function UnicodePosEx(c: UnicodeChar; const s: UnicodeString; p: Integer): Integer;
function AssignDiffering(const Source: UnicodeString; var Target: UnicodeString): Boolean;
function ToUpperUtf8(const s: String): String;
function ToLowerUtf8(const s: String): String;

procedure WriteStreamInt64(Stream: TStream; Value: Int64);
procedure WriteStreamInteger(Stream: TStream; Value: Integer);
procedure WriteStreamCardinal(Stream: TStream; Value: Cardinal);
procedure WriteStreamSizedString(Stream: TStream; const s: String);
procedure WriteStreamString(Stream: TStream; const s: String);
procedure WriteStreamDouble(Stream: TStream; const Value: Double);
procedure WriteStreamBoolean(Stream: TStream; Value: Boolean);
procedure WriteStreamSingle(Stream: TStream; Value: Single);

function ReadStreamInt64(Stream: TStream): Int64;
function ReadStreamInteger(Stream: TStream): Integer;
function ReadStreamCardinal(Stream: TStream): Cardinal;
function ReadStreamSizedString(Stream: TStream): String;
function ReadStreamFixedString(Stream: TStream; StringLength: Integer): String;
function ReadStreamDouble(Stream: TStream): Double;
function ReadStreamBoolean(Stream: TStream): Boolean;
function ReadStreamSingle(Stream: TStream): Single;

function ReadStreamTail(Stream: TStream): String;
function ReadUnseekableStreamTail(Stream: TStream): String;
function CopyStreamTail(Source, Target: TStream): Integer;
procedure CopyStreamPart(Source, Target: TStream; const PartSize: Int64);
procedure SafeMoveFile(const OldName, NewName: String);

function GetUiDecimalSeparator: Char;
function GetEmptyFormatSettings: TFormatSettings;

function GetIntervalSince(OldTickCount: Cardinal): Cardinal;
function GetExeFileName: String;
function GetExeDirectory: String;
function MakeAbsoluteFileName(const FileName: String): String;

function ShiftDown: Boolean;
function LeftButtonDown: Boolean;

function CompareDoubles(const Value1, Value2: Double): Integer;
function CompareIntegers(const Value1, Value2: Integer): Integer;
function CompareSingles(const Value1, Value2: Single): Integer;

function FindArrayInteger(const a: array of Integer; n: Integer): Integer;

function SamePoint(const p1, p2: TPoint): Boolean;
function InflateRectangle(const r: TRect; dx, dy: Integer): TRect;
function IntersectSegments(a1, b1, a2, b2: Integer; out a, b: Integer): Boolean;
function SegmentsOverlap(a1, b1, a2, b2: Integer): Boolean;

procedure ShuffleList(List: TFPSList; RandomGenerator: TRandomIntegerGenerator);
procedure PermuteList(List: TFPSList; Permutation: TIntegerArray);
function GenerateRandomPermutation(Count: Integer; RandomGenerator: TRandomIntegerGenerator): TIntegerArray;

procedure DestroyOwnedComponents(Owner: TComponent);
function FindOwnedComponent(Owner: TComponent; const ComponentName: String): TComponent;

function KindToString(Kind: TKind): String;
function StringToKind(const s: String): TKind;
function BooleanToString(Value: Boolean): String;
function StringToBoolean(const s: String): Boolean;

implementation

resourcestring
  SUiDecimalSeparator = '.';
  SReference9NotSupported = 'The reference "\9" is not supported.';
  SSafeMoveFileError = 'Can''t move the file.' + LineEnding + LineEnding
    + 'Old name: "%s".' + LineEnding
    + 'New name: "%s".' + LineEnding
    + 'Error code: %d.';
  SCantCreateFile = 'Can''t create file "%s".';
  SCantOpenFile = 'Can''t open file "%s".';

var
  EmptyFormatSettings: TFormatSettings;

{ TGenericList<T> }

function TGenericList<T>.PointerComparator(Left, Right: Pointer): Integer;
begin
  Result := FComparator(T(Left^), T(Right^));
end;

procedure TGenericList<T>.SortEx(Comparator: TComparator);
begin
  FComparator := Comparator;
  TFPSList(Self).Sort(PointerComparator);
end;

{ TGenericObjectList<T> }

function TGenericObjectList<T>.AddSafely(Item: T): T;
begin
  try
    Add(Item);
    Result := Item;
  except
    Item.Free;
    raise;
  end;
end;

procedure TGenericObjectList<T>.InsertSafely(Index: Integer; Item: T);
begin
  try
    Insert(Index, Item);
  except
    Item.Free;
    raise;
  end;
end;

{ TUnicodeFileStream }

constructor TUnicodeFileStream.CreateNew(const FileName: String; SharedForReading: Boolean = FALSE);
var
  UnicodeFileName: UnicodeString;
  ShareMode: Cardinal;
begin
  UnicodeFileName := UTF8Decode(FileName);
  if SharedForReading then
    ShareMode := FILE_SHARE_READ
  else
    ShareMode := 0;
  inherited Create(CreateFileW(PWideChar(UnicodeFileName), GENERIC_READ or GENERIC_WRITE,
    ShareMode, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0));
  if Handle = INVALID_HANDLE_VALUE then
    raise EFCreateError.CreateFmt(SCantCreateFile, [FileName]);
end;

constructor TUnicodeFileStream.OpenForRead(const FileName: String);
var
  UnicodeFileName: UnicodeString;
begin
  UnicodeFileName := UTF8Decode(FileName);
  inherited Create(CreateFileW(PWideChar(UnicodeFileName), GENERIC_READ,
    FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0));
  if Handle = INVALID_HANDLE_VALUE then
    raise EFOpenError.CreateFmt(SCantOpenFile, [FileName]);
end;

destructor TUnicodeFileStream.Destroy;
begin
  if Handle <> INVALID_HANDLE_VALUE then
    CloseHandle(Handle);
  inherited;
end;

{ TBigInteger }

function ModulusLessOrEqualThan(const m1, m2: String): Boolean;
begin
  if Length(m1) < Length(m2) then
    Result := TRUE
  else if Length(m1) > Length(m2) then
    Result := FALSE
  else
    Result := m1 <= m2;
end;

procedure ModulusPad(const m1, m2: String; ExtraZeros: Integer; out p1, p2: String);
var
  n: Integer;
begin
  n := Max(Length(m1), Length(m2));
  p1 := StringOfChar('0', n - Length(m1) + ExtraZeros) + m1;
  p2 := StringOfChar('0', n - Length(m2) + ExtraZeros) + m2;
end;

procedure CutLeadingZeros(var s: String);
var
  ZeroCount: Integer;
begin
  ZeroCount := 0;
  while (ZeroCount < Length(s)) and (s[ZeroCount+1] = '0') do
    Inc(ZeroCount);
  if ZeroCount > 0 then
    Delete(s, 1, ZeroCount);
end;

function ModulusAdd(const m1, m2: String): String;
var
  p1, p2: String;
  i: Integer;
  Carry, n: Byte;
begin
  ModulusPad(m1, m2, 1, p1, p2);
  SetLength(Result, Length(p1));

  Carry := 0;
  for i := Length(Result) downto 1 do
  begin
    n := (Ord(p1[i]) - Ord('0')) + (Ord(p2[i]) - Ord('0')) + Carry;
    if n >= 10 then
    begin
      Carry := 1;
      n := n - 10;
    end
    else
      Carry := 0;
    Result[i] := Chr(n + Ord('0'));
  end;

  CutLeadingZeros(Result);
end;

function ModulusSubtract(const m1, m2: String): String;
{ Assert: ModulusLessOrEqualThan(m2, m1) }
var
  p1, p2: String;
  i: Integer;
  Carry, n: ShortInt;
begin
  ModulusPad(m1, m2, 0, p1, p2);
  SetLength(Result, Length(p1));

  Carry := 0;
  for i := Length(Result) downto 1 do
  begin
    n := (Ord(p1[i]) - Ord('0')) - (Ord(p2[i]) - Ord('0')) - Carry;
    if n < 0 then
    begin
      Carry := 1;
      n := n + 10;
    end
    else
      Carry := 0;
    Result[i] := Chr(n + Ord('0'));
  end;
  Assert( Carry = 0 );
  
  CutLeadingZeros(Result);
end;

function TBigInteger.Add(Other: TBigInteger): TBigInteger;
var
  Neg, NonNeg: TBigInteger;
begin
  Result := TBigInteger.Create;
  try
    if FNegative = Other.FNegative then { same signs }
    begin
      Result.FNegative := FNegative;
      Result.FModulus := ModulusAdd(FModulus, Other.FModulus);
    end
    else { different signs }
    begin
      if FNegative then
      begin
        Neg := Self;
        NonNeg := Other;
      end
      else
      begin
        Neg := Other;
        NonNeg := Self;
      end;

      Result.FNegative := not ModulusLessOrEqualThan(Neg.FModulus, NonNeg.FModulus);
      if Result.FNegative then
        Result.FModulus := ModulusSubtract(Neg.FModulus, NonNeg.FModulus)
      else
        Result.FModulus := ModulusSubtract(NonNeg.FModulus, Neg.FModulus);
    end;
  except
    Result.Free;
    raise;
  end;
end;

function TBigInteger.IsEqual(Other: TBigInteger): Boolean;
begin
  Result :=
        (FNegative = Other.FNegative)
    and (FModulus = Other.FModulus);
end;

function TBigInteger.GetIsZero: Boolean;
begin
  Result := FModulus = '';
end;

function TBigInteger.GetValue: String;
begin
  if FNegative then
    Result := '-'
  else
    Result := '';

  if FModulus <> '' then
    Result := Result + FModulus
  else
    Result := Result + '0';
end;

function TBigInteger.InvertSign: TBigInteger;
begin
  Result := TBigInteger.Create;
  try
    Result.FModulus := FModulus;
    if not IsZero then
      Result.FNegative := not FNegative;
  except
    Result.Free;
    raise;
  end;
end;

function TBigInteger.IsNearby(Other, Delta: TBigInteger): Boolean;
var
  Diff: TBigInteger;
begin
  if Delta.IsZero then { performance optimization }
    Result := IsEqual(Other)
  else if Delta.FNegative then
    Result := FALSE
  else
  begin
    Diff := Subtract(Other);
    try
      Result := ModulusLessOrEqualThan(Diff.FModulus, Delta.FModulus);
    finally
      Diff.Free;
    end;
  end;
end;

function TBigInteger.Subtract(Other: TBigInteger): TBigInteger;
var
  MinusOther: TBigInteger;
begin
  MinusOther := Other.InvertSign;
  try
    Result := Add(MinusOther);
  finally
    MinusOther.Free;
  end;
end;

{ TFixedPointDecimal }

function TFixedPointDecimal.IsEqual(Other: TFixedPointDecimal): Boolean;
begin
  Result :=
    (FNegative = Other.FNegative) and
    (FWholePart = Other.FWholePart) and
    (FFractionPart = Other.FFractionPart);
end;

function TFixedPointDecimal.GetValue: String;
begin
  if FNegative then
    Result := '-'
  else
    Result := '';

  if FWholePart <> '' then
    Result := Result + FWholePart
  else
    Result := Result + '0';

  if FFractionPart <> '' then
    Result := Result + '.' + FractionPart;
end;

function TFixedPointDecimal.GetIsZero: Boolean;
begin
  Result := (FWholePart = '') and (FFractionPart = '');
end;

class function TFixedPointDecimal.IsValidNonNegative(const s: String): Boolean;
var
  n: TFixedPointDecimal;
begin
  n := Parse(s);
  try
    Result := (n <> nil) and not n.FNegative;
  finally
    n.Free;
  end;
end;

class function TFixedPointDecimal.MustParse(
  const s: String): TFixedPointDecimal;
begin
  Result := Parse(s);
  if Result = nil then
    raise Exception.CreateFmt('Invalid number: "%s".', [s]);
end;

function TFixedPointDecimal.IsNearby(Other,
  Delta: TFixedPointDecimal): Boolean;
var
  Scale: Integer;
  SelfInt, OtherInt, DeltaInt: TBigInteger;
begin
  if Delta.IsZero then { performance optimization }
    Result := IsEqual(Other)
  else
  begin
    Scale := Max(Max(Length(FFractionPart), Length(Other.FFractionPart)),
      Length(Delta.FFractionPart));
    SelfInt := ToBigInteger(Scale);
    try
      OtherInt := Other.ToBigInteger(Scale);
      try
        DeltaInt := Delta.ToBigInteger(Scale);
        try
          Result := SelfInt.IsNearby(OtherInt, DeltaInt);
        finally
          DeltaInt.Free;
        end;
      finally
        OtherInt.Free;
      end;
    finally
      SelfInt.Free;
    end;
  end;
end;

class function TFixedPointDecimal.Normalize(const s: String): String;
var
  n: TFixedPointDecimal;
begin
  n := MustParse(s);
  try
    Result := n.Value;
  finally
    n.Free;
  end;
end;

class function TFixedPointDecimal.Parse(const s: String): TFixedPointDecimal;
{ Returns nil if s doesn't contain a number. }
var
  p: Integer;
  Negative, SeparatorFound, Error: Boolean;
  Whole, Fraction: String;
begin
  if s = '' then
    Result := nil
  else
  begin
    Negative := FALSE;
    p := 1;
    if s[1] = '+' then
      p := 2
    else if s[1] = '-' then
    begin
      Negative := TRUE;
      p := 2;
    end;

    Whole := '';
    Fraction := '';
    SeparatorFound := FALSE;
    Error := FALSE;

    while (p <= Length(s)) and not Error do
    begin
      if (s[p] >= '0') and (s[p] <= '9') then
      begin
        if SeparatorFound then
          Fraction := Fraction + s[p]
        else
          Whole := Whole + s[p];
        Inc(p);
      end
      else if (s[p] = '.') or (s[p] = ',') then
      begin
        if SeparatorFound or (Whole = '') then
          Error := TRUE
        else
          SeparatorFound := TRUE;
        Inc(p);
      end
      else
        Error := TRUE;
    end;
    if (Whole = '') or (SeparatorFound and (Fraction = '')) then
      Error := TRUE;

    if Error then
      Result := nil
    else
    begin
      CutLeadingZeros(Whole);

      p := Length(Fraction);
      while (p > 0) and (Fraction[p] = '0') do
        Dec(p);
      Fraction := Copy(Fraction, 1, p);

      if (Whole = '') and (Fraction = '') then
        Negative := FALSE;

      Result := TFixedPointDecimal.Create;
      try
        Result.FNegative := Negative;
        Result.FWholePart := Whole;
        Result.FFractionPart := Fraction;
      except
        Result.Free;
        raise;
      end;
    end;
  end;
end;

function TFixedPointDecimal.ToBigInteger(Scale: Integer): TBigInteger;
var
  s: String;
begin
  Assert( Scale >= Length(FFractionPart) );

  s := FWholePart + FFractionPart + StringOfChar('0', Scale - Length(FFractionPart));
  CutLeadingZeros(s);

  Result := TBigInteger.Create;
  try
    Result.FNegative := FNegative;
    Result.FModulus := s;
  except
    Result.Free;
    raise;
  end;
end;

{ TOutputFile }

procedure TOutputFile.Commit;
begin
  Assert( not FCommitted );
  FreeAndNil(FStream);
  SafeMoveFile(FTempFileName, FFileName);
  FCommitted := TRUE;
end;

constructor TOutputFile.Create(const FileName: String);
begin
  inherited Create;
  FFileName := FileName;
  FTempFileName := ChangeFileExt(FileName, '.$$$');
  FStream := TUnicodeFileStream.CreateNew(FTempFileName);
end;

destructor TOutputFile.Destroy;
begin
  FreeAndNil(FStream);
  if not FCommitted then
    DeleteFileUTF8(FTempFileName);
  inherited;
end;

procedure SplitUnicodeString(const s: UnicodeString; Delimiter: UnicodeChar; Parts: TUnicodeStringList);
var
  i, PartStart: Integer;

  procedure AddPart(NextDelimiter: Integer);
  var
    PartLength: Integer;
  begin
    PartLength := NextDelimiter - PartStart;
    if PartLength > 0 then
      Parts.Add(Copy(s, PartStart, PartLength));
    PartStart := NextDelimiter + 1;
  end;

begin
  PartStart := 1;
  for i := 1 to Length(s) do
    if s[i] = Delimiter then
      AddPart(i);
  AddPart(Length(s) + 1);
end;

procedure WriteStreamString(Stream: TStream; const s: String);
begin
  if s <> '' then
    Stream.WriteBuffer(Pointer(s)^, Length(s));
end;

procedure WriteStreamInt64(Stream: TStream; Value: Int64);
begin
  Stream.WriteBuffer(Value, SizeOf(Value));
end;

procedure WriteStreamSizedString(Stream: TStream; const s: String);
begin
  WriteStreamInteger(Stream, Length(s));
  WriteStreamString(Stream, s);
end;

function ReadStreamInteger(Stream: TStream): Integer;
begin
  {$HINTS OFF}
  Stream.ReadBuffer(Result, SizeOf(Result));
  {$HINTS ON}
end;

procedure WriteStreamInteger(Stream: TStream; Value: Integer);
begin
  Stream.WriteBuffer(Value, SizeOf(Value));
end;

function ReadStreamTail(Stream: TStream): String;
var
  BytesLeft: Integer;
begin
  BytesLeft := Max(Stream.Size - Stream.Position, 0);
  SetLength(Result, BytesLeft);
  if BytesLeft > 0 then
    Stream.ReadBuffer(Result[1], BytesLeft);
end;

function ReadUnseekableStreamTail(Stream: TStream): String;
var
  Buffer: TMemoryStream;
begin
  Buffer := TMemoryStream.Create;
  try
    CopyStreamTail(Stream, Buffer);
    Buffer.Seek(0, soFromBeginning);
    Result := ReadStreamTail(Buffer);
  finally
    Buffer.Free;
  end;
end;

function ReadStreamInt64(Stream: TStream): Int64;
begin
  {$HINTS OFF}
  Stream.ReadBuffer(Result, SizeOf(Result));
  {$HINTS ON}
end;

function ReadStreamSizedString(Stream: TStream): String;
var
  Size: Integer;
begin
  Size := ReadStreamInteger(Stream);
  if (Size < 0) or (Size > Stream.Size - Stream.Position) then
    raise Exception.Create('Invalid string size when reading from stream.');

  SetLength(Result, Size);
  if Size > 0 then
    Stream.ReadBuffer(Result[1], Size);
end;

function ReadStreamFixedString(Stream: TStream; StringLength: Integer): String;
begin
  SetLength(Result, StringLength);
  if StringLength > 0 then
    Stream.ReadBuffer(Result[1], StringLength);
end;

function CompareDoubles(const Value1, Value2: Double): Integer;
begin
  if Value1 > Value2 then
    Result := 1
  else if Value1 < Value2 then
    Result := -1
  else
    Result := 0;
end;

function CompareSingles(const Value1, Value2: Single): Integer;
begin
  if Value1 > Value2 then
    Result := 1
  else if Value1 < Value2 then
    Result := -1
  else
    Result := 0;
end;

function CompareIntegers(const Value1, Value2: Integer): Integer;
begin
  if Value1 > Value2 then
    Result := 1
  else if Value1 < Value2 then
    Result := -1
  else
    Result := 0;
end;

function GetIntervalSince(OldTickCount: Cardinal): Cardinal;
begin
  Result := GetTickCount - OldTickCount;
end;

function GetExeFileName: String;
var
  n: Integer;
  ExeName: array [0..MAX_PATH] of UnicodeChar;
begin
  n := GetModuleFileNameW(0, ExeName, MAX_PATH);
  if (n = 0) or (n >= MAX_PATH) then
    raise Exception.Create('GetModuleFileNameW failed.');
  Result := UTF8Encode(UnicodeString(ExeName))
end;

function GetExeDirectory: String;
begin
  Result := ExtractFileDir(GetExeFileName);
end;

function MakeAbsoluteFileName(const FileName: String): String;
var
  u: UnicodeString;
  Buffer: array [0..MAX_PATH] of UnicodeChar;
  Dummy: PWideChar;
  n: Integer;
begin
  u := UTF8Decode(FileName);
  {$HINTS OFF}
  n := GetFullPathNameW(PWideChar(u), MAX_PATH, Buffer, Dummy);
  {$HINTS ON}
  if (n = 0) or (n > MAX_PATH) then
    raise Exception.Create('GetFullPathNameW failed.');
  Result := UTF8Encode(UnicodeString(Buffer));
end;

function ContainsSpecialCharacter(const s: String): Boolean;
var
  c: Char;
begin
  Result := FALSE;
  for c in s do
    if c < ' ' then
    begin
      Result := TRUE;
      Break;
    end;
end;

function ContainsUnicodeZeroCharacter(const s: UnicodeString): Boolean;
begin
  Result := Pos(#0, s) > 0;
end;

function GetStringTailAfterLastDelimiter(const s: String; Delimiter: Char): String;
var
  p: Integer;
begin
  p := RPos(Delimiter, s);
  if p = 0 then
    Result := ''
  else
    Result := Copy(s, p+1, Length(s)-p);
end;

function FindArrayInteger(const a: array of Integer; n: Integer): Integer;
begin
  for Result := Low(a) to High(a) do
    if a[Result] = n then
      Exit;
  Result := -1;
end;

function ShiftDown: Boolean;
begin
  Result := GetKeyState(VK_SHIFT) < 0;
end;

function LeftButtonDown: Boolean;
begin
  Result := GetKeyState(VK_LBUTTON) < 0;
end;

function SamePoint(const p1, p2: TPoint): Boolean;
begin
  Result := (p1.x = p2.x) and (p1.y = p2.y);
end;

function ReadStreamDouble(Stream: TStream): Double;
begin
  {$HINTS OFF}
  Stream.ReadBuffer(Result, SizeOf(Result));
  {$HINTS ON}
end;

function ReadStreamBoolean(Stream: TStream): Boolean;
begin
  Result := Stream.ReadByte <> 0;
end;

function ReadStreamSingle(Stream: TStream): Single;
begin
  {$HINTS OFF}
  Stream.ReadBuffer(Result, SizeOf(Result));
  {$HINTS ON}
end;

procedure WriteStreamDouble(Stream: TStream; const Value: Double);
begin
  Stream.WriteBuffer(Value, SizeOf(Value));
end;

procedure WriteStreamBoolean(Stream: TStream; Value: Boolean);
begin
  Stream.WriteBuffer(Value, SizeOf(Value));
end;

procedure WriteStreamSingle(Stream: TStream; Value: Single);
begin
  Stream.WriteBuffer(Value, SizeOf(Value));
end;

procedure ShuffleList(List: TFPSList; RandomGenerator: TRandomIntegerGenerator);
var
  i: Integer;
begin
  for i := List.Count-1 downto 1 do
    List.Exchange(i, RandomGenerator(i+1));
end;

function CollapseSpaces(const s: String): String;
begin
  Result := DelSpace1(s);
  if (Result <> '') and (Result[1] = ' ') then
    Delete(Result, 1, 1);
  if (Result <> '') and (Result[Length(Result)] = ' ') then
    Delete(Result, Length(Result), 1);
end;

function CollapseUnicodeSpaces(const s: UnicodeString): UnicodeString;
begin
  Result := UTF8Decode(CollapseSpaces(UTF8Encode(s)));
end;

function ReadStreamCardinal(Stream: TStream): Cardinal;
begin
  {$HINTS OFF}
  Stream.ReadBuffer(Result, SizeOf(Result));
  {$HINTS ON}
end;

procedure WriteStreamCardinal(Stream: TStream; Value: Cardinal);
begin
  Stream.WriteBuffer(Value, SizeOf(Value));
end;

function ExcludeLeadingDot(const s: String): String;
begin
  if (s <> '') and (s[1] = '.') then
    Result := Copy(s, 2, Length(s)-1)
  else
    Result := s;
end;

function CopyStreamTail(Source, Target: TStream): Integer;
{ Returns the number of bytes copied. }
var
  Buffer: array [0..4095] of Byte;
  Count: Integer;
begin
  Result := 0;
  repeat
    {$HINTS OFF}
    Count := Source.Read(Buffer, SizeOf(Buffer));
    {$HINTS ON}
    if Count > 0 then
    begin
      Target.WriteBuffer(Buffer, Count);
      Inc(Result, Count);
    end;
  until Count = 0;
end;

procedure CopyStreamPart(Source, Target: TStream; const PartSize: Int64);
var
  BytesCopied, BytesRead: Int64;
  Buffer: array [0..4095] of Byte;
begin
  Assert( PartSize >= 0 );
  BytesCopied := 0;

  while BytesCopied < PartSize do
  begin
    {$HINTS OFF}
    BytesRead := Source.Read(Buffer, Min(PartSize - BytesCopied, SizeOf(Buffer)));
    {$HINTS ON}
    if BytesRead = 0 then
      raise Exception.Create('Unexpected end of stream.');
    Assert( BytesRead > 0 );

    Target.WriteBuffer(Buffer, BytesRead);
    Inc(BytesCopied, BytesRead);
  end;
end;

function IntersectSegments(a1, b1, a2, b2: Integer; out a, b: Integer): Boolean;
{ [a1...b1], [a2...b2] - input segments, [a...b] - intersection. }
begin
  if (a1 > b1) or (a2 > b2) or (a1 > b2) or (b1 < a2) then
  begin
    a := 0;
    b := -1;
    Result := FALSE;
  end
  else
  begin
    a := Max(a1, a2);
    b := Min(b1, b2);
    Result := TRUE;
  end;
end;

function SegmentsOverlap(a1, b1, a2, b2: Integer): Boolean;
{ [a1...b1], [a2...b2] - input segments. }
var
  DummyA, DummyB: Integer;
begin
  Result := IntersectSegments(a1, b1, a2, b2, DummyA, DummyB);
end;

function GenerateRandomPermutation(Count: Integer; RandomGenerator: TRandomIntegerGenerator): TIntegerArray;
var
  List: TIntegerList;
  i: Integer;
begin
  Assert( Count >= 0 );

  List := TIntegerList.Create;
  try
    List.Count := Count;
    for i := 0 to Count-1 do
      List[i] := i;

    ShuffleList(List, RandomGenerator);

    SetLength(Result, Count);
    for i := 0 to Count-1 do
      Result[i] := List[i];
  finally
    List.Free;
  end;
end;

procedure PermuteList(List: TFPSList; Permutation: TIntegerArray);
var
  i, Count: Integer;
begin
  Count := List.Count;
  if Count >= 2 then
  begin
    Assert( Length(Permutation) = Count );
    List.Count := Count * 2;
    for i := 0 to Count-1 do
      List.Exchange(Permutation[i], i+Count);
    for i := 0 to Count-1 do
      List.Exchange(i, i+Count);
    List.Count := Count;
  end;
end;

function ReplacePattern(const s, OldPattern, NewPattern: String; out ReplaceCount: Integer): String;
{ Ignores the case of English letters when searching for OldPattern. }
var
  UppercasedS, UppercasedOldPattern: String;
  CurPos, Index, OldPatternLength: Integer;
begin
  UppercasedS := UpperCase(s);
  UppercasedOldPattern := UpperCase(OldPattern);

  Result := '';
  OldPatternLength := Length(OldPattern);
  ReplaceCount := 0;
  CurPos := 1;
  repeat
    Index := PosEx(UppercasedOldPattern, UppercasedS, CurPos);
    if Index <> 0 then
    begin
      Result := Result + Copy(s, CurPos, Index-CurPos) + NewPattern;
      CurPos := Index + OldPatternLength;
      Inc(ReplaceCount);
    end;
  until Index = 0;
  Result := Result + Copy(s, CurPos, Length(s)-CurPos+1);
end;

function ConvertFloatToString(const Value: Extended; DigitsAfterDecimalPoint: Integer;
  DecimalSeparator: Char; OutputTrailingZeros: Boolean = FALSE): String;
var
  FormatSettings: TFormatSettings;
  c: Char;
  FractionFormat: String;
begin
  FormatSettings := GetEmptyFormatSettings;
  FormatSettings.DecimalSeparator := DecimalSeparator;
  if OutputTrailingZeros then
    c := '0'
  else
    c := '#';
  FractionFormat := StringOfChar(c, Max(Min(DigitsAfterDecimalPoint, 10), 0));
  if FractionFormat <> '' then
    FractionFormat := '.' + FractionFormat;

  Result := FormatFloat('0' + FractionFormat, Value, FormatSettings);

  if Result = '-0' then
    Result := '0';
end;

function ReplaceFirstOccurrence(const s: String; Pattern, Replacement: Char): String;
var
  p: Integer;
begin
  Result := s;
  p := Pos(Pattern, s);
  if p > 0 then
    Result[p] := Replacement;
end;

function CommaToDot(const s: String): String;
begin
  Result := ReplaceFirstOccurrence(s, ',', '.');
end;

function DotToUiDecimalSeparator(const s: String): String;
begin
  Result := ReplaceFirstOccurrence(s, '.', GetUiDecimalSeparator);
end;

function CutUnicodeCharacters(const s: UnicodeString; c: UnicodeChar): UnicodeString;
var
  n: Integer;
  v: UnicodeChar;
begin
  SetLength(Result, Length(s));
  n := 0;

  for v in s do
  begin
    if v <> c then
    begin
      Inc(n);
      Result[n] := v;
    end;
  end;

  SetLength(Result, n);
end;

function UnicodeStringConsistsOf(const s: UnicodeString; c: UnicodeChar): Boolean;
var
  e: UnicodeChar;
begin
  Result := s <> '';
  for e in s do
    if e <> c then
    begin
      Result := FALSE;
      Break;
    end;
end;

procedure SafeMoveFile(const OldName, NewName: String);
var
  OldUnicodeName, NewUnicodeName: UnicodeString;
begin
  OldUnicodeName := UTF8Decode(OldName);
  NewUnicodeName := UTF8Decode(NewName);
  if not MoveFileExW(PWideChar(OldUnicodeName), PWideChar(NewUnicodeName), MOVEFILE_REPLACE_EXISTING) then
    raise Exception.CreateFmt(SSafeMoveFileError, [OldName, NewName, GetLastError]);
end;

function GetUiDecimalSeparator: Char;
var
  s: String;
begin
  s := SUiDecimalSeparator;
  Assert( Length(s) = 1 );
  Result := s[1];
end;

function GetEmptyFormatSettings: TFormatSettings;
begin
  Result := EmptyFormatSettings;
end;

function ShiftRegexpBackReferences(const s: UnicodeString): UnicodeString;
var
  i: Integer;
  InComment: Boolean;
  LastCharWasBackslash: Boolean;
  c: UnicodeChar;
begin
  Result := s;
  InComment := FALSE;
  LastCharWasBackslash := FALSE;
  for i := 1 to Length(Result) do
  begin
    c := Result[i];
    if InComment then
    begin
      if c = ')' then
        InComment := FALSE;
    end
    else if LastCharWasBackslash then
    begin
      LastCharWasBackslash := FALSE;
      if c = '9' then
        raise Exception.Create(SReference9NotSupported);
      if (c >= '1') and (c <= '8') then
        Result[i] := Succ(c);
    end
    else if c = '\' then
      LastCharWasBackslash := TRUE
    else if (c = '(') and (Copy(Result, i+1, 2) = '?#') then
      InComment := TRUE;
  end;
end;

function UnicodePosEx(c: UnicodeChar; const s: UnicodeString; p: Integer): Integer;
var
  Len: Integer;
begin
  if p <= 0 then
    Result := 0
  else
  begin
    Len := Length(s);
    while (p <= Len) and (s[p] <> c) do
      Inc(p);
    if p <= Len then
      Result := p
    else
      Result := 0;
  end;
end;

function AssignDiffering(const Source: UnicodeString; var Target: UnicodeString): Boolean;
begin
  Result := Source <> Target;
  if Result then
    Target := Source;
end;

function ToUpperUtf8(const s: String): String;
begin
  Result := UTF8Encode(UnicodeUpperCase(UTF8Decode(s)));
end;

function ToLowerUtf8(const s: String): String;
begin
  Result := UTF8Encode(UnicodeLowerCase(UTF8Decode(s)));
end;

procedure DestroyOwnedComponents(Owner: TComponent);
begin
  while Owner.ComponentCount > 0 do
    Owner.Components[Owner.ComponentCount-1].Destroy;
end;

function FindOwnedComponent(Owner: TComponent; const ComponentName: String): TComponent;
begin
  Result := Owner.FindComponent(ComponentName);
  if Result = nil then
    raise Exception.CreateFmt('Component "%s" was not found in "%s": %s.',
      [ComponentName, Owner.Name, Owner.ClassName]);
end;

function InflateRectangle(const r: TRect; dx, dy: Integer): TRect;
begin
  Result := Rect(r.Left - dx, r.Top - dy, r.Right + dx, r.Bottom + dy);
end;

function KindToString(Kind: TKind): String;
begin
  Result := LowerCase(IntToHex(Kind, 16));
end;

function StringToKind(const s: String): TKind;
begin
  Result := StrToInt64('$' + s);
end;

function BooleanToString(Value: Boolean): String;
begin
  if Value then
    Result := '1'
  else
    Result := '0';
end;

function StringToBoolean(const s: String): Boolean;
begin
  Result := s = '1';
end;

end.

